module XI.Directory.WS.Types where

import Text.XML.Light.Types
import qualified Data.Map as Map
import Data.List (nubBy, (\\))
import Data.Char

data WsDescr  = WsDescr {
				  wsdNamespaces		:: [(String, String)],
				  wsdName 			:: String,
				  wsdOpers 			:: [WsOper]
				} deriving (Show, Eq)

data WsOper   = WsOper {
				  wsopName 			:: String,
				  wsopInput			:: WsElem,
				  wsopOutput 		:: WsElem
				} deriving (Show, Eq)

data WsElem   = WsElem {
				  wselPrefix		:: String,
				  wselName 			:: String,
				  wselType 			:: WsType,
				  wselMinOccurs		:: MinOcc,
				  wselMaxOccurs		:: MaxOcc,
				  wselNillable 		:: Bool,
				  wselAlias			:: String
				} deriving (Show, Eq, Ord)

data MinOcc   = Zero | MinOne	deriving (Show, Eq, Ord)
data MaxOcc   = MaxOne | Unbounded deriving (Show, Eq, Ord)
	
data WsType   = WsComplexType {
					wsctName		:: String,
					wsctAlias		:: String,
					wsctElems		:: [WsElem]
				} {- (Maybe String) [WsElem] -}
			  | WsSimpleType String 
			    deriving (Show, Eq, Ord)
				
type TypeNamesMap = Map.Map String (String, String, Map.Map String String) -- typeName newTypeName, fieldPrefix, Map fieldName newFieldName

-- changeOp wsd f = wsd { wsdOpers = [ op { wsopInput = f }
setAliases :: WsDescr -> [(String, String, String, [(String, String)])] -> WsDescr
setAliases wsd ml = 
	wsd { wsdOpers = [ op { wsopInput = f (wsopInput op), wsopOutput = f (wsopOutput op)} | op <- wsdOpers wsd ]	}
	where
		m = Map.fromList . map (\(old, new, pref, fs) -> (old, (new, pref, Map.fromList fs))) $ ml
		f io = setAliasesEl m "" Map.empty io

setAliasesTp m (WsComplexType n _ es) = WsComplexType n a $ map (setAliasesEl m p m') es where
	(a, p, m') = Map.findWithDefault (defName n, defPref, Map.empty) n m
	defPref = map toLower $ filter isUpper n
setAliasesTp _ st = st

setAliasesEl m p m' e = e { 
		wselAlias = p ++ Map.findWithDefault (defName $ wselName e) (wselName e) m',
		wselType = setAliasesTp m $ wselType e
	}

defName name = let dn = defName' 2 name in if 3 > (length . take 3 $ dn) then name else dn
	where
		defName' _ "" = ""
		defName' 0 name = '_':name
		defName' k (n:name) = 
			(n:) . defName' (k-1) $ dropWhile (not . isUpper) name

getAliases :: WsDescr -> [(String, String, String, [(String, String)])]
getAliases wsd = nubBy (\(a,_,_,_) (b,_,_,_) -> a == b) $ concat [getAliasesTp t | 
		op <- wsdOpers wsd,
		t <- map (wselType . (flip ($) op)) [wsopInput, wsopOutput]
	]
	
getAliasesTp :: WsType -> [(String, String, String, [(String, String)])]
getAliasesTp (WsComplexType n a es) = (n, a, p, map (\e' ->(wselName e', wselAlias e' \\ p)) es):(concat $[getAliasesTp $ wselType e | e <- es])
	where 
		p = getPrefix "" $ map wselAlias es
		getPrefix _ [] = ""
		getPrefix _ [_] = ""
		getPrefix p' ("":es') = reverse p'
		getPrefix p' ((c':cs'):es') = if all (\e'->[c'] == (take 1 e')) es' then getPrefix (c':p') $ cs':(map tail es') else reverse p'

getAliasesTp _ = []
